(module mp7-tests mzscheme
  
  (provide tests-for-run tests-for-check)
  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
  
  (define tests-for-run
    '(
  
      ;; simple arithmetic
      (positive-const "11" 11)
      (negative-const "-33" -33)
      (simple-arith-1 "-(44,33)" 11)
  
      ;; nested arithmetic
      (nested-arith-left "-(-(44,33),22)" -11)
      (nested-arith-right "-(55, -(22,11))" 44)
  
      ;; simple variables
      (test-var-1 "x" 10)
      (test-var-2 "-(x,1)" 9)
      (test-var-3 "-(1,x)" -9)
      
      ;; simple unbound variables
      (test-unbound-var-1 "foo" error)
      (test-unbound-var-2 "-(x,foo)" error)
  
      ;; simple conditionals
      (if-true "if zero?(0) then 3 else 4" 3)
      (if-false "if zero?(1) then 3 else 4" 4)

      ;; make sure that the test and both arms get evaluated
      ;; properly. 
      (if-eval-test-true "if -(11,12) then 3 else 4" 3)
      (if-eval-test-false "if -(11, 11) then 3 else 4" 4)
      (if-eval-then "if 1 then -(22,1) else -(22,2)" 21)
      (if-eval-else "if 0 then -(22,1) else -(22,2)" 20)

      ;; and make sure the other arm doesn't get evaluated.
      (if-eval-test-true-2 "if -(11, 12) then 3 else foo" 3)
      (if-eval-test-false-2 "if -(11,11) then foo else 4" 4)

      ;; simple let
      (simple-let-1 "let x = 3 in x" 3)

      ;; make sure the body and rhs get evaluated
      (eval-let-body "let x = 3 in -(x,1)" 2)
      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)

      ;; check nested let and shadowing
      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)

      ;; simple applications
      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" 29)
      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" 29)
      (let-to-proc-1 "(proc(f : (int -> int))(f 30)  proc(x : int)-(x,1))" 29)


      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" -1)
      (nested-procs2 "let f = proc (x : int) proc (y : int) -(x,y) in ((f -(10,5)) 6)"
        -1)
      
      ;; simple letrecs
      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" 32)
      (simple-letrec-2
        "letrec int f (x : int) = if x then -((f -(x,1)), -2) else 0 in (f 4)"
        8)

      (double-it "
letrec int double (n : int) = if zero?(n) then 0 
                                  else -( (double -(n,1)), -2)
in (double 3)"
        6)

      (simple-letrec-3
        "let m = -5 
 in letrec int f (x : int) = if x then -((f -(x,1)), m) else 0 in (f 4)"
        20)

      ;;
      ;; explicit store run tests
      ;;
  (deref-int
   "let l = newref(5) in deref(l)"
   5)
  
  (deref-proc
   "let l = newref(5)
    in let fl = newref(proc(int x) x)
    in (deref(fl) deref(l))"
   5)
  
  (deref-let-proc
   "let l = newref(5)
    in let fl = let f = proc(x : int) -(x,1)
                in newref(f)
    in (deref(fl) deref(l))"
   4)
  
  (deref-letrec-proc
   "let plus = proc(x : int) proc(y : int) -(x, -(0, y))
     in letrec
       (int -> int)
       times(x : int) = proc(c : int)
         if zero?(c)
          then 0
          else ((plus x) ((times x) -(c, 1)))
     in let l = newref(5)
     in let fl = letrec
                   int
                   fact(i : int) = if zero?(i)
                                 then 1
                                 else ((times i) (fact -(i,1)))
                 in newref(fact)
     in (deref(fl) deref(l))"
   120)
  
  (setref-value
   "let l = newref(5)
    in let v = setref(l, 6)
    in deref(l)"
   6)
  
  (ref-spaggeti-deref
   "let l3 = let l1 = newref(5)
             in let l2 = newref(l1)
             in newref(l2)
    in deref(deref(deref(l3)))"
   5)
  
  (ref-store-loop
   "let plus = proc(x : int) proc(y : int) -(x, -(0, y))
     in letrec
       (int -> int)
       times(x : int) = proc(c : int)
         if zero?(c)
          then 0
          else ((plus x) ((times x) -(c, 1)))
    in let fl = newref(proc(x : int) x)
    in let fact = proc(n : int)
                    if zero?(n) then 1
                    else ((times n) (deref(fl)  -(n,1)))
    in let v = setref(fl, fact)
    in (fact 5)"
   120)

  ;;
  ;; explicit-mutable-pairs
  ;;
  
  (right-simple
   "let p = newpair(5,proc(x : int) zero?(x))
     in (right(p) 1)"
    0)

  (right-nested
   "let p = newpair(newpair(zero?(1),proc(int x) x),
                    newpair(5,proc(x : int) zero?(x)))
     in (right(right(p)) 1)"
    0)
  
  (left-simple
   "let p = newpair(5,proc(x : int) zero?(x))
     in left(p)"
    5)

  (left-nested
   "let p = newpair(newpair(zero?(1),proc(x : int) x),
                    newpair(5,proc(x : int) zero?(x)))
     in left(left(p))"
    0)
  
  (left-right-nested
   "let p = newpair(newpair(zero?(1), proc(x : int) x),
                    newpair(5, proc(x : int) zero?(x)))
     in left(right(p))"
    5)

  (right-left-nested
   "let p = newpair(newpair(zero?(1),proc(x : int) x),
                    newpair(5,proc(x : int) zero?(x)))
     in (right(left(p)) 13)"
    13)
  
  (setleft-simple
   "let p = newpair(5,proc(x : int) zero?(x))
     in let z = setleft(p, 3)
      in left(p)"
   3)

  (setleft-nested
   "let p = newpair(newpair(zero?(1),proc(x : int) x),
                    newpair(5,proc(x : int) zero?(x)))
     in let z = setleft(left(p), zero?(0))
      in left(left(p))"
   137)

  (setleft-pair
   "let p = newpair(newpair(zero?(1),proc(x : int) x),
                    newpair(5,proc(int x) zero?(x)))
     in let z = setleft(p, newpair(zero?(0),proc(x : int) 1))
      in left(left(p))"
   137)
  
  (setleft-ref-app
   "let p = newpair(newref(proc(x : int) x),
                    newpair(5,proc(x : int) zero?(x)))
     in let fptr = newref(proc(x : int) 1)
      in let z = setleft(p, fptr)
       in (deref(left(p)) 2)"
   1)
  
  (setright-simple
   "let p = newpair(5,proc(x : int) zero?(x))
     in let z = setright(p,proc(x : int) zero?(-(x,1)))
     in (right(p) 1)"
    137)

  (setright-nested
   "let p = newpair(newpair(zero?(1),proc(x : int) x),
                    newpair(5,proc(x : int) zero?(x)))
    in let z = setright(right(p), proc(x : int) zero?(-(x,1)))
     in (right(right(p)) 1)"
    137)
  
  (setright-pair
   "let p = newpair(newpair(zero?(1),proc(x : int) x),
                    newpair(5,proc(int x) zero?(x)))
     in let z = setright(p, newpair(0,proc(x : int) zero?(1)))
      in (right(right(p)) 0)"
   0)
  
  (setright-ref-app
   "let p = newpair(newpair(5,proc(x : int) zero?(x)),
                    newref(proc(x : int) x))
     in let fptr = newref(proc(x : int) 1)
      in let z = setright(p, fptr)
       in (deref(right(p)) 2)"
   1)

  ;pairs & refs
  
  (setref-refof-pair
   "let p12 = newpair(1,2) in
    let p34 = newpair(3,4)
     in let r12 = newref(p12)
     in let r34 = newref(p34)
         in let z = setref(r34, deref(r12))
             in left(deref(r34))"
   1)

  (setright-refof-pair
   "let p12 = newpair(1,2) in
    let p34 = p12
     in let r12 = newref(p12)
     in let r34 = newref(p34)
         in let z = setright(deref(r34), 7)
             in right(deref(r12))"
   7)
  
  (setref-refof-pair-2
   "let p12 = newpair(1,2) in
    let p34 = newpair(3,4)
     in let r12 = newref(p12)
     in let r34 = newref(p34)
         in let z = setref(r34, deref(r12))
         in let z = setleft(deref(r12), 7)
             in left(deref(r34))"
   7)
  
  ;; begin-end
  
  (begin-end-1
   "begin -(3,1) end"
   2)

  (begin-end-nested
   "begin 
     begin 1; zero?(0) end;
     (begin zero?(1); 
      begin proc(x : int) x end
     end 15)
    end"
   15)

;;   ;; multiple-argument procedures
;;   (mult-arg-proc-2
;;    "let app2 = proc(f : (int * int -> int), int : x, y : int)
;;              (f x y)
;;      in let plus = proc (x : int, y : int) -(x, -(0, y))
;;       in (app2 plus 7 11)"
;;    18)
  
  
  ))

  ;;;
  ;;; Tests for type-check
  ;;;
  
  
  (define tests-for-check
    '(
      ;; tests from run-tests:
  
      ;; simple arithmetic
      (positive-const "11" int)
      (negative-const "-33" int)
      (simple-arith-1 "-(44,33)" int)
  
      ;; nested arithmetic
      (nested-arith-left "-(-(44,33),22)" int)
      (nested-arith-right "-(55, -(22,11))" int)
  
      ;; simple variables
      (test-var-1 "x" int)
      (test-var-2 "-(x,1)" int)
      (test-var-3 "-(1,x)" int)

      (zero-test-1 "zero?(-(3,2))" bool)
      (zero-test-2 "-(2,zero?(0))" error)
      
      ;; simple unbound variables
      (test-unbound-var-1 "foo" error)
      (test-unbound-var-2 "-(x,foo)" error)
  
      ;; simple conditionals
      (if-true "if zero?(1) then 3 else 4" int)
      (if-false "if zero?(0) then 3 else 4" int)

      ;; make sure that the test and both arms get evaluated
      ;; properly. 
      (if-eval-test-true "if zero?(-(11,12)) then 3 else 4" int)
      (if-eval-test-false "if zero?(-(11, 11)) then 3 else 4" int)
      (if-eval-then "if zero?(1) then -(22,1) else -(22,2)" int)
      (if-eval-else "if zero?(0) then -(22,1) else -(22,2)" int)
      
      ;; make sure types of arms agree (new for lang5-1)
      
      (if-compare-arms "if zero?(0) then 1 else zero?(1)" error)
      (if-check-test-is-boolean "if 1 then 11 else 12" error)

      ;; simple let
      (simple-let-1 "let x = 3 in x" int)

      ;; make sure the body and rhs get evaluated
      (eval-let-body "let x = 3 in -(x,1)" int)
      (eval-let-rhs "let x = -(4,1) in -(x,1)" int)

      ;; check nested let and shadowing
      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" int)
      (check-shadowing-in-body "let x = 3 in let x = 4 in x" int)
      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" int)

      ;; simple applications
      (apply-proc-in-rator-pos "(proc(int x) -(x,1)  30)" int)
      (apply-simple-proc "let f = proc (int x) -(x,1) in (f 30)" int)
      (let-to-proc-1 "(proc( (int -> int) f)(f 30)  proc(int x)-(x,1))" int)


      (nested-procs "((proc (int x) proc (int y) -(x,y)  5) 6)" int)
      (nested-procs2 "let f = proc (int x) proc (int y) -(x,y) in ((f -(10,5)) 3)"
                     int)
      
      ;; simple letrecs
      (simple-letrec-1 "letrec int f(int x) = -(x,1) in (f 33)" int)
      (simple-letrec-2
        "letrec int f(int x) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4)"
        int)

      (simple-letrec-3
        "let m = -5 
 in letrec int f(int x) = if zero?(x) then -((f -(x,1)), m) else 0 in (f 4)"
        int)

      (double-it "
letrec int double (int n) = if zero?(n) then 0 
                                  else -( (double -(n,1)), -2)
in (double 3)"
        int)

      ;; tests of expressions that produce procedures

      (build-a-proc-typed "proc (int x) -(x,1)" (int -> int))

      (build-a-proc-typed-2 "proc (int x) zero?(-(x,1))" (int -> bool))
      
      (bind-a-proc-typed
        "let f = proc (int x) -(x,1) in (f 4)"
        int) 

      (bind-a-proc-return-proc
        "let f = proc (int x) -(x,1) in f"
        (int -> int))

      (type-a-ho-proc-1
        "proc((int -> bool) f) (f 3)"
        ((int  -> bool) -> bool))

      (type-a-ho-proc-2
        "proc((bool -> bool) f) (f 3)"
        error)

      (apply-a-ho-proc
        "proc (int x) proc ( (int -> bool) f) (f x)"
        (int -> ((int -> bool) -> bool)))

      (apply-a-ho-proc-2
        "proc (int x) proc ( (int -> (int -> bool)) f) (f x)"
        (int -> ((int -> (int -> bool)) -> (int -> bool))) )

      (apply-a-ho-proc-3
        "proc (int x) proc ( (int -> (int -> bool)) f) (f zero?(x))"
	error)

      (apply-curried-proc
        "((proc(int x) proc (int y)-(x,y)  4) 3)"
        int)

      (apply-a-proc-2-typed
        "(proc (int x) -(x,1) 4)" 
        int)

      (apply-a-letrec "
letrec int f(int x) = -(x,1)
in (f 40)"
        int)

      (letrec-non-shadowing
   "(proc (int x)
      letrec bool loop(bool x) =(loop x)
       in x
     1)"
        int)


      (letrec-return-fact "
let times = proc (int x) proc (int y) -(x,y)    % not really times
in letrec 
     int fact(int x) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
   in fact"
        (int -> int))

      (letrec-apply-fact "
let times = proc (int x) proc (int y) -(x,y)    % not really times
in letrec 
     int fact(int x) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
   in (fact 4)"
        int)


      
      
  ;;
  ;; explicit store
  ;;
  (type-newref-1
   "newref(5)"
   (refto int))
  
  (type-newref-2
   "newref(proc(int x) x)"
   (refto (int -> int)))
  
  (deref-int
   "let l = newref(5) in deref(l)"
   int)
  
  (deref-proc
   "let l = newref(5)
    in let fl = newref(proc(int x) x)
    in (deref(fl) deref(l))"
   int)
  
  (apply-to-loc-type-error
   "let l = newref(5)
    in let fl = newref(proc(int x) x)
    in (deref(fl) l)"
   error)
  
  (deref-let-proc
   "let l = newref(5)
    in let fl = let f = proc(int x) -(x,1)
                in newref(f)
    in (deref(fl) deref(l))"
   int)
  
  (deref-letrec-proc
   "let plus = proc(int x) proc(int y) -(x, -(0, y))
     in letrec
       (int -> int)
       times(int x) = proc(int c)
         if zero?(c)
          then 0
          else ((plus x) ((times x) -(c, 1)))
     in let l = newref(5)
     in let fl = letrec
                   int
                   fact(int i) = if zero?(i)
                                 then 1
                                 else ((times i) (fact -(i,1)))
                 in newref(fact)
     in (deref(fl) deref(l))"
   int)
  
  (setref-value
   "let l = newref(5)
    in let v = setref(l, 6)
    in deref(l)"
   int)
  
  (setref-type-err
   "let l = newref(5)
    in let v = setref(l, zero?(5))
    in deref(l)"
   error)
  
  (setref-type-err-2
   "let l = newref(5)
    in let v = setref(l, 4)
    in zero?(v)"
   error)

  (setref-type-err-3
   "let l = newref(5)
    in let v = setref(l, 4)
    in -(v,1)"
   error)
  
  (ref-spaggeti-typecheck
   "let l1 = newref(5)
    in let l2 = newref(l1)
    in let l3 = newref(l2)
    in l3"
   (refto (refto (refto int))))
  
  (ref-spaggeti-deref
   "let l3 = let l1 = newref(5)
             in let l2 = newref(l1)
             in newref(l2)
    in deref(deref(deref(l3)))"
   int)
  
  (ref-store-loop
   "let plus = proc(int x) proc(int y) -(x, -(0, y))
     in letrec
       (int -> int)
       times(int x) = proc(int c)
         if zero?(c)
          then 0
          else ((plus x) ((times x) -(c, 1)))
    in let fl = newref(proc(int x) x)
    in let fact = proc(int n)
                    if zero?(n) then 1
                    else ((times n) (deref(fl)  -(n,1)))
    in let v = setref(fl, fact)
    in (fact 5)"
   int)
  
  ;;
  ;; explicit-mutable-pairs
  ;;
  
  (newpair-simple
   "newpair(5,proc(int x) zero?(x))"
   (pairof int * (int -> bool)))

  (newpair-ref
   "newref(newpair(5,proc(int x) zero?(x)))"
   (refto (pairof int * (int -> bool))))
    
  (newpair-nested
   "newpair(newpair(5,proc(int x) zero?(x)),
            newpair(5,proc(int x) zero?(x)))"
   (pairof (pairof int * (int -> bool)) * (pairof int * (int -> bool))))
  
  (right-simple
   "let p = newpair(5,proc(int x) zero?(x))
     in right(p)"
    (int -> bool))

  (right-nested
   "let p = newpair(newpair(zero?(1),proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
     in right(right(p))"
    (int -> bool))
  
  (left-simple
   "let p = newpair(5,proc(int x) zero?(x))
     in left(p)"
    int)

  (left-nested
   "let p = newpair(newpair(zero?(1),proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
     in left(left(p))"
    bool)
  
  (left-right-nested
   "let p = newpair(newpair(zero?(1),proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
     in left(right(p))"
    int)

  (right-left-nested
   "let p = newpair(newpair(zero?(1),proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
     in right(left(p))"
    (int -> int))
  
  (setleft-simple
   "let p = newpair(5,proc(int x) zero?(x))
     in let z = setleft(p, 3)
      in left(p)"
   int)

  (setleft-nested
   "let p = newpair(newpair(zero?(1),proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
     in let z = setleft(left(p), zero?(0))
      in left(left(p))"
   bool)

  (setleft-pair
   "let p = newpair(newpair(zero?(1),proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
     in let z = setleft(p, newpair(zero?(0),proc(int x) 1))
      in left(left(p))"
   bool)
  
  (setleft-ref
   "let p = newpair(newref(proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
     in let fptr = newref(proc(int x) 1)
      in let z = setleft(p, fptr)
       in left(p)"
   (refto (int -> int)))

  (setleft-ref-app
   "let p = newpair(newref(proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
     in let fptr = newref(proc(int x) 1)
      in let z = setleft(p, fptr)
       in (deref(left(p)) 2)"
   int)
  
  (setright-simple
   "let p = newpair(5,proc(int x) zero?(x))
     in let z = setright(p,proc(int x) zero?(-(x,1)))
     in right(p)"
    (int -> bool))

  (setright-nested
   "let p = newpair(newpair(zero?(1),proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
    in let z = setright(right(p), proc(int x) zero?(-(x,1)))
     in right(right(p))"
    (int -> bool))
  
  (setright-pair
   "let p = newpair(newpair(zero?(1),proc(int x) x),
                    newpair(5,proc(int x) zero?(x)))
     in let z = setright(p, newpair(0,proc(int x) zero?(1)))
      in right(right(p))"
   (int -> bool))
  
  (setright-ref
   "let p = newpair(newpair(5,proc(int x) zero?(x)),
                    newref(proc(int x) x))
     in let fptr = newref(proc(int x) 1)
      in let z = setright(p, fptr)
       in right(p)"
   (refto (int -> int)))

  (setright-ref-app
   "let p = newpair(newpair(5,proc(int x) zero?(x)),
                    newref(proc(int x) x))
     in let fptr = newref(proc(int x) 1)
      in let z = setright(p, fptr)
       in (deref(right(p)) 2)"
   int)

  ;pairs & refs
  
  (refof-pair
   "newref(newpair(1,2))"
   (refto (pairof int * int)))

  (setref-refof-pair
   "let p12 = newpair(1,2)
     in let p34 = newpair(3,4)
      in let r12 = newref(p12)
       in let r34 = newref(p34)
        in let z = setref(r34, deref(r12))
         in left(deref(r34))"
   int)

  (setright-refof-pair
   "let p12 = newpair(1,2)
     in let p34 = p12
      in let r12 = newref(p12)
       in let r34 = newref(p34)
        in let z = setright(deref(r34), 7)
         in right(deref(r34))"
   int)
  
  ;pair type errors

  (left-terr
   "let p = newpair(5,proc(int x) zero?(x))
      in (left(p) 1)"
   error)
  
  (right-terr
   "let p = newpair(5,proc(int x) zero?(x))
       in (right(p) zero?(0))"
   error)
  
  (setleft-terr
   "let p = newpair(5,proc(int x) zero?(x))
     in let z = setleft(p, zero?(5))
      in left(p)"
   error)
  
  (setright-terr
   "let p = newpair(5,proc(int x) zero?(x))
     in let f = proc(int x) x
      in let z = setright(p, f)
       in (right(p) 17)"
   error)

  (setleft-retval-terr-1
   "let l = newpair(5,4)
    in let v = setleft(l,2)
    in zero?(v)"
   error)

  (setleft-retval-terr-2
   "let l = newpair(5,4)
    in let v = setleft(l,2)
    in -(v,1)"
   error)

  (setright-retval-terr-1
   "let l = newpair(5,4)
    in let v = setright(l,2)
    in zero?(v)"
   error)

  (setright-retval-terr-2
   "let l = newpair(5,4)
    in let v = setright(l,2)
    in -(v,1)"
   error)
  
  (deref-pair-terr
   "let p = newpair(5,proc(int x) zero?(x))
     in deref(p)"
   error)

  (left-ref-terr
   "let p = newref(3)
     in left(p)"
   error)

  ;; begin-end
  (begin-end-single
   "begin zero?(0) end"
   bool)
  
  (begin-end-2
   "begin 1; zero?(0) end"
   bool)
  
  (begin-end-nested
   "begin 
     begin 1; zero?(0) end;
     begin zero?(1); 
      begin proc(int x) x end
     end
    end"
   (int -> int))
  
;;   ;; multiple-argument procedures
;;   (mult-arg-proc-1
;;    "proc(int x, (int -> int) y) (y x)"
;;    (int * (int -> int) -> int))

;;   (mult-arg-proc-2
;;    "let app2 = proc( (int * int -> int) f, int x, int y)
;;              (f x y)
;;      in let plus = proc (int x, int y) -(x, -(0, y))
;;       in (app2 plus 7 11)"
;;    int)
  
  ))
  
)